Visual Basic Graphics Programming (2nd Edition)/Visual Basic Graphics Programming 2nd Edition.iso/OldSrc/CH9/SRC/DISTORT.FRM

Visual Basic Form | 1996-05-01 | 6.0 KB | 200 lines

VERSION 4.00
Begin VB.Form DistortForm
   Caption         =   "Distort"
   ClientHeight    =   5925
   ClientLeft      =   1710
   ClientTop       =   750
   ClientWidth     =   5910
   Height          =   6615
   KeyPreview      =   -1  'True
   Left            =   1650
   LinkTopic       =   "Form1"
   ScaleHeight     =   5925
   ScaleWidth      =   5910
   Top             =   120
   Width           =   6030
   Begin VB.PictureBox Canvas
      AutoRedraw      =   -1  'True
      Height          =   5895
      Left            =   0
      ScaleHeight     =   -800
      ScaleLeft       =   -400
      ScaleMode       =   0  'User
      ScaleTop        =   400
      ScaleWidth      =   800
      TabIndex        =   0
      Top             =   0
      Width           =   5895
   End
   Begin VB.Menu mnuFile
      Caption         =   "&File"
      Begin VB.Menu mnuFileExit
         Caption         =   "E&xit"
      End
   End
   Begin VB.Menu mnuTrans
      Caption         =   "&Transformation"
      Begin VB.Menu mnuTransChoice
         Caption         =   "&None"
         Checked         =   -1  'True
         Index           =   0
         Shortcut        =   ^N
      End
      Begin VB.Menu mnuTransChoice
         Caption         =   "&Sines"
         Index           =   1
         Shortcut        =   ^S
      End
      Begin VB.Menu mnuTransChoice
         Caption         =   "&Twist"
         Index           =   2
         Shortcut        =   ^T
      End
      Begin VB.Menu mnuTransChoice
         Caption         =   "&Circle"
         Index           =   3
         Shortcut        =   ^C
      End
   End
Attribute VB_Name = "DistortForm"
Attribute VB_Creatable = False
Attribute VB_Exposed = False
Option Explicit
Dim ThePicture As ObjPicture
' Location of viewing eye.
Dim EyeR As Single
Dim EyeTheta As Single
Dim EyePhi As Single
' Location of focus point.
Const FocusX = 0#
Const FocusY = 0#
Const FocusZ = 0#
Dim Projector(1 To 4, 1 To 4) As Single
Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
Const Dtheta = PI / 20
    Select Case KeyCode
        Case vbKeyLeft
            EyeTheta = EyeTheta - Dtheta

        Case vbKeyRight
            EyeTheta = EyeTheta + Dtheta

        Case vbKeyUp
            EyePhi = EyePhi - Dtheta

        Case vbKeyDown
            EyePhi = EyePhi + Dtheta

        Case Else
            Exit Sub
    End Select
    MousePointer = vbHourglass
    DoEvents
    m3PProject Projector, m3Perspective, EyeR, EyePhi, EyeTheta, FocusX, FocusY, FocusZ, 0, 1, 0
    DrawData canvas
    MousePointer = vbDefault
End Sub
Private Sub Form_Load()
    Me.Show
    MousePointer = vbHourglass
    DoEvents
    ' Initialize the eye position.
    EyeR = 1500
    EyeTheta = PI * 0.17
    EyePhi = PI * 0.16
    ' Create the data.
    CreateData
    ' Display the data.
    m3PProject Projector, m3Perspective, EyeR, EyePhi, EyeTheta, FocusX, FocusY, FocusZ, 0, 1, 0
    DrawData canvas
    MousePointer = vbDefault
End Sub
Private Sub mnuFileExit_Click()
    Unload Me
End Sub
' ***********************************************
' Create some polylines to display.
' ***********************************************
Sub CreateData()
Const GAP = 25
Dim i As Single
Dim j As Single
Dim poly As ObjPolyline
    ' Create the picture object.
    Set ThePicture = New ObjPicture
    ' Create the top (perpendicular to Y axis).
    Set poly = New ObjPolyline
    ThePicture.objects.Add poly
    For i = -200 To 200 Step GAP
        For j = -200 To 200 - GAP Step GAP
            poly.AddSegment i, 200, j, i, 200, j + GAP
            poly.AddSegment j, 200, i, j + GAP, 200, i
        Next j
    Next i
    ' Create the front (perpendicular to Z axis).
    Set poly = New ObjPolyline
    ThePicture.objects.Add poly
    For i = -200 To 200 Step GAP
        For j = -200 To 200 - GAP Step GAP
            poly.AddSegment i, j, 200, i, j + GAP, 200
            poly.AddSegment j, i, 200, j + GAP, i, 200
        Next j
    Next i
    ' Create the side (perpendicular to X axis).
    Set poly = New ObjPolyline
    ThePicture.objects.Add poly
    For i = -200 To 200 Step GAP
        For j = -200 To 200 - GAP Step GAP
            poly.AddSegment 200, i, j, 200, i, j + GAP
            poly.AddSegment 200, j, i, 200, j + GAP, i
        Next j
    Next i
End Sub
' ***********************************************
' Display the data.
' ***********************************************
Private Sub DrawData(pic As Object)
    ' Transform the points.
    ThePicture.ApplyFull Projector
    ' Draw the points.
    pic.Cls
    ThePicture.Draw pic
    pic.Refresh
End Sub
Private Sub mnuTransChoice_Click(Index As Integer)
Dim trans As Object
Dim i As Integer
    MousePointer = vbHourglass
    DoEvents
    ' Check the selected transformation.
    For i = 0 To 3
        mnuTransChoice(i).Checked = False
    Next i
    mnuTransChoice(Index).Checked = True
    ' Reload the data.
    CreateData
    ' Load the correct transformation.
    Select Case Index
        Case 1  ' Sines.
            Set trans = New DistortSines
            trans.amplitude = 30
            trans.period = 150
        Case 2  ' Twist.
            Set trans = New DistortTwist
            trans.Cx = 0
            trans.Cz = 0
            trans.offset = -100
            trans.period = 500 * PI
        Case 3  ' Circle.
            Set trans = New DistortCircle
            trans.amplitude = 12.5
            trans.period = 150
    End Select
    ' If the transformation is not none, apply it.
    If Index > 0 Then ThePicture.Distort trans
    ' Redraw the picture.
    m3PProject Projector, m3Perspective, EyeR, EyePhi, EyeTheta, FocusX, FocusY, FocusZ, 0, 1, 0
    DrawData canvas
    MousePointer = vbDefault
End Sub